home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0009_DIRTREE.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  14KB  |  427 lines
  1. Program Vtree2;
  2.  
  3. {$B-,D+,R-,S-,V-}
  4. {
  5.    ┌────────────────────────────────────────────────────┐
  6.    │ Uses and GLOBAL VarIABLES & ConstANTS              │
  7.    └────────────────────────────────────────────────────┘
  8. }
  9.  
  10. Uses
  11.   Crt, Dos;
  12.  
  13. Const
  14.   NL        = #13#10;
  15.   NonVLabel = ReadOnly + Hidden + SysFile + Directory + Archive;
  16.  
  17. Type
  18.  
  19.   FPtr      = ^Dir_Rec;
  20.  
  21.   Dir_Rec   = Record                             { Double Pointer Record    }
  22.     DirName : String[12];
  23.     DirNum  : Integer;
  24.     Next    : Fptr;
  25.   end;
  26.  
  27.   Str_Type  = String[65];
  28.  
  29. Var
  30.   Version   : String;
  31.   Dir       : str_Type;
  32.   Loop      : Boolean;
  33.   Level     : Integer;
  34.   Flag      : Array[1..5] of String[20];
  35.   TreeOnly  : Boolean;
  36.   Filetotal : LongInt;
  37.   Bytetotal : LongInt;
  38.   Dirstotal : LongInt;
  39.   tooDeep   : Boolean;
  40.   ColorCnt  : Byte;
  41.  
  42. {
  43.    ┌────────────────────────────────────────────────────┐
  44.    │ Procedure Beepit                                   │
  45.    └────────────────────────────────────────────────────┘
  46. }
  47.  
  48. Procedure Beepit;
  49.  
  50. begin
  51.   Sound (760);                                          { Beep the speaker }
  52.   Delay (80);
  53.   NoSound;
  54. end;
  55.  
  56. {
  57.    ┌────────────────────────────────────────────────────┐
  58.    │ Procedure Usage                                    │
  59.    └────────────────────────────────────────────────────┘
  60. }
  61.  
  62. Procedure Usage;
  63.  
  64. begin
  65.   BEEPIT;
  66.   Write (NL,
  67.     'Like the Dos TREE command, and similar to PC Magazine''s VTREE, but gives',NL,
  68.     'you a Graphic representation of your disk hierarchical tree structure and',NL,
  69.     'the number of Files and total Bytes in each tree node (optionally can be',NL,
  70.     'omitted).  Also allows starting at a particular subdirectory rather than',NL,
  71.     'displaying the entire drive''s tree structure.  Redirection of output and',NL,
  72.     'input is an option.',NL,NL, 'USAGE:     VTREE2 {path} {/t} {/r}',NL,NL,
  73.     '/t or /T omits the number of Files and total Bytes inFormation.',NL,
  74.     '/r or /R activates redirection of input and output.',NL,NL, Version);
  75.   Halt;
  76. end;
  77.  
  78. {
  79. ┌────────────────────────────────────────────────────┐
  80. │ Function Format                                    │
  81. └────────────────────────────────────────────────────┘
  82. }
  83.  
  84. Function Format (Num : LongInt) : String;   {converts Integer to String}
  85.                                             {with commas inserted      }
  86. Var
  87.   NumStr : String[12];
  88.   Place  : Byte;
  89.  
  90. begin
  91.   Place := 3;
  92.   STR (Num, NumStr);
  93.   Num := Length (NumStr);                  {re-use Num For Length value }
  94.  
  95.   While Num > Place do                     {insert comma every 3rd place}
  96.   begin
  97.     inSERT (',',NumStr, Num - (Place -1));
  98.     inC (Place, 3);
  99.   end;
  100.  
  101.   Format := NumStr;
  102. end;
  103.  
  104. {
  105.    ┌────────────────────────────────────────────────────┐
  106.    │ Procedure DisplayDir                               │
  107.    └────────────────────────────────────────────────────┘
  108. }
  109.  
  110. Procedure DisplayDir (DirP : str_Type; DirN : str_Type; Levl : Integer;
  111.                      NumSubsVar2 : Integer; SubNumVar2 : Integer;
  112.                      NumSubsVar3 : Integer;
  113.                      NmbrFil : Integer; FilLen : LongInt);
  114.  
  115. {NumSubsVar2 is the # of subdirs. in previous level;
  116.  NumSumsVar3 is the # of subdirs. in the current level.
  117.  DirN is the current subdir.; DirP is the previous path}
  118.  
  119. Const
  120.   LevelMax = 5;
  121. Var
  122.   BegLine : String;
  123.   MidLine : String;
  124.   Blank   : String;
  125.   WrtStr  : String;
  126.  
  127. begin
  128.  
  129.   if Levl > 5 then
  130.   begin
  131.     BEEPIT;
  132.     tooDeep := True;
  133.     Exit;
  134.   end;
  135.  
  136.   Blank   := '               ';                  { Init. Variables          }
  137.   BegLine := '';
  138.   MidLine := ' ──────────────────';
  139.  
  140.   if Levl = 0 then                               { Special handling For     }
  141.     if Dir = '' then                             { initial (0) dir. level   }
  142.       if not TreeOnly then
  143.         WrtStr := 'ROOT ──'
  144.       else
  145.         WrtStr := 'ROOT'
  146.     else
  147.       if not TreeOnly then
  148.         WrtStr := DirP + ' ──'
  149.       else
  150.         WrtStr := DirP
  151.   else
  152.   begin                                        { Level 1+ routines        }
  153.     if SubNumVar2 = NumSubsVar2 then           { if last node in subtree, }
  154.     begin                                    { use └─ symbol & set flag }
  155.       BegLine  := '└─';                      { padded With blanks       }
  156.       Flag[Levl] := ' ' + Blank;
  157.     end
  158.     else                                       { otherwise, use ├─ symbol }
  159.     begin                                    { & set flag padded With   }
  160.       BegLine    := '├─';                    { blanks                   }
  161.       Flag[Levl] := '│' + Blank;
  162.     end;
  163.  
  164.     Case Levl of                               { Insert │ & blanks as     }
  165.       1: BegLine := BegLine;                  { needed, based on level   }
  166.       2: Begline := Flag[1] + BegLine;
  167.       3: Begline := Flag[1] + Flag[2] + BegLine;
  168.       4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;
  169.       5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;
  170.     end; {end Case}
  171.  
  172.     if (NumSubsVar3 = 0) then                  { if cur. level has no     }
  173.       WrtStr := BegLine + DirN                 { subdirs., leave end blank}
  174.     else
  175.     begin
  176.       WrtStr := BegLine + DirN + COPY(Midline,1,(13-Length(DirN)));
  177.       if Levl < LevelMax then
  178.         WrtStr := WrtStr + '─┐'
  179.       else                                   { if level 5, special      }
  180.       begin                                { end to indicate more     }
  181.         DELETE (WrtStr,Length(WrtStr),1);  { levels                   }
  182.         WrtStr := WrtStr + '»';
  183.       end;
  184.     end;
  185.   end;                                         { end level 1+ routines    }
  186.  
  187.   if ODD(ColorCnt) then
  188.     TextColor (3)
  189.   else
  190.     TextColor (11);
  191.   inC (ColorCnt);
  192.  
  193.   if ((Levl < 4) or ((Levl = 4) and (NumSubsVar3=0))) and not TreeOnly then
  194.     WriteLn (WrtStr,'':(65-Length(WrtStr)), Format(NmbrFil):3,
  195.              Format(FilLen):11)
  196.   else
  197.     WriteLn (WrtStr);                            { Write # of Files & Bytes  }
  198.                                                  { only if it fits, else     }
  199. end;                                             { Write only tree outline   }
  200.  
  201.  
  202. {
  203.    ┌────────────────────────────────────────────────────┐
  204.    │ Procedure DisplayHeader                            │
  205.    └────────────────────────────────────────────────────┘
  206. }
  207.  
  208. Procedure DisplayHeader;
  209.  
  210. begin
  211.   WriteLn ('DIRECtoRIES','':52,'FileS','      ByteS');
  212.   WriteLn ('═══════════════════════════════════════════════════════════════════════════════');
  213. end;
  214.  
  215. {
  216.    ┌────────────────────────────────────────────────────┐
  217.    │ Procedure DisplayTally                             │
  218.    └────────────────────────────────────────────────────┘
  219. }
  220.  
  221. Procedure DisplayTally;
  222.  
  223. begin
  224.   WriteLn('':63,'════════════════');
  225.   WriteLn('NUMBER of DIRECtoRIES: ', Dirstotal:3, '':29,
  226.           'toTALS: ', Format (Filetotal):5, Format (Bytetotal):11);
  227. end;
  228.  
  229. {
  230.    ┌────────────────────────────────────────────────────┐
  231.    │ Procedure ReadFiles                                │
  232.    └────────────────────────────────────────────────────┘
  233. }
  234.  
  235. Procedure ReadFiles (DirPrev : str_Type; DirNext : str_Type;
  236.                      SubNumVar1 : Integer; NumSubsVar1 : Integer);
  237.  
  238. Var
  239.   FileInfo  : SearchRec;
  240.   FileBytes : LongInt;
  241.   NumFiles  : Integer;
  242.   NumSubs   : Integer;
  243.   Dir_Ptr   : FPtr;
  244.   CurPtr    : FPtr;
  245.   FirstPtr  : FPtr;
  246.  
  247. begin
  248.   FileBytes := 0;
  249.   NumFiles  := 0;
  250.   NumSubs   := 0;
  251.   Dir_Ptr   := nil;
  252.   CurPtr    := nil;
  253.   FirstPtr  := nil;
  254.  
  255.   if Loop then
  256.     FindFirst (DirPrev + DirNext + '\*.*', NonVLabel, FileInfo);
  257.   Loop      := False;                            { Get 1st File             }
  258.  
  259.   While DosError = 0 do                          { Loop Until no more Files }
  260.   begin
  261.     if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
  262.     begin
  263.       if (FileInfo.attr = directory) then    { if fetched File is dir., }
  264.       begin                                { store a Record With dir. }
  265.         NEW (Dir_Ptr);                     { name & occurence number, }
  266.         Dir_Ptr^.DirName  := FileInfo.name;{ and set links to         }
  267.         inC (NumSubs);                     { other Records if any     }
  268.         Dir_Ptr^.DirNum   := NumSubs;
  269.         if CurPtr = nil then
  270.         begin
  271.           Dir_Ptr^.Next := nil;
  272.           CurPtr        := Dir_Ptr;
  273.           FirstPtr      := Dir_Ptr;
  274.         end
  275.         else
  276.         begin
  277.           Dir_Ptr^.Next := nil;
  278.           CurPtr^.Next  := Dir_Ptr;
  279.           CurPtr        := Dir_Ptr;
  280.         end;
  281.       end
  282.       else
  283.       begin                                { Tally # of Bytes in File }
  284.         FileBytes := FileBytes + FileInfo.size;
  285.         inC (NumFiles);                    { Increment # of Files,    }
  286.       end;                                 { excluding # of subdirs.  }
  287.     end;
  288.     FindNext (FileInfo);                       { Get next File            }
  289.   end;    {end While}
  290.  
  291.   Bytetotal := Bytetotal + FileBytes;
  292.   Filetotal := Filetotal + NumFiles;
  293.   Dirstotal := Dirstotal + NumSubs;
  294.  
  295.   DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,
  296.               NumFiles, FileBytes);            { Pass info to & call      }
  297.   inC (Level);                                 { display routine, & inc.  }
  298.                                                { level number             }
  299.  
  300.  
  301.   While (FirstPtr <> nil) do                   { if any subdirs., then    }
  302.   begin                                      { recursively loop thru    }
  303.     Loop     := True;                        { ReadFiles proc. til done }
  304.     ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,
  305.                 FirstPtr^.DirNum, NumSubs);
  306.     FirstPtr := FirstPtr^.Next;
  307.   end;
  308.  
  309.   DEC (Level);                                 { Decrement level when     }
  310.                                                { finish a recursive loop  }
  311.                                                { call to lower level of   }
  312.                                                { subdir.                  }
  313. end;
  314.  
  315. {
  316.    ┌────────────────────────────────────────────────────┐
  317.    │ Procedure Read_Parm                                │
  318.    └────────────────────────────────────────────────────┘
  319. }
  320.  
  321. Procedure Read_Parm;
  322.  
  323. Var
  324.   Cur_Dir : String;
  325.   Param   : String;
  326.   i       : Integer;
  327.  
  328. begin
  329.  
  330.   if ParamCount > 3 then
  331.     Usage;
  332.   Param := '';
  333.  
  334.   For i := 1 to ParamCount do                    { if either param. is a T, }
  335.   begin                                        { set TreeOnly flag            }
  336.     Param := ParamStr(i);
  337.     if Param[1] = '/' then
  338.       Case Param[2] of
  339.         't','T': begin
  340.                    TreeOnly := True;
  341.                    if ParamCount = 1 then
  342.                      Exit;
  343.                  end;                          { Exit if only one param   }
  344.  
  345.         'r','R': begin
  346.                    ASSIGN (Input,'');          { Override Crt Unit, &     }
  347.                    RESET (Input);              { make input & output      }
  348.                    ASSIGN (Output,'');         { redirectable             }
  349.                    REWrite (Output);
  350.                    if ParamCount = 1 then
  351.                      Exit;
  352.                  end;                          { Exit if only one param   }
  353.         '?'    : Usage;
  354.  
  355.         else
  356.           Usage;
  357.       end; {Case}
  358.   end;
  359.  
  360.   GETDIR (0,Cur_Dir);                            { Save current dir         }
  361.   For i := 1 to ParamCount do
  362.   begin
  363.     Param := ParamStr(i);                      { Set Var to param. String }
  364.     if (POS ('/',Param) = 0) then
  365.     begin
  366.       Dir := Param;
  367. {$I-} CHDIR (Dir);                           { Try to change to input   }
  368.       if Ioresult = 0 then                   { dir.; if it exists, go   }
  369.       begin                                { back to orig. dir.       }
  370. {$I+}   CHDIR (Cur_Dir);
  371.         if (POS ('\',Dir) = Length (Dir)) then
  372.           DELETE (Dir,Length(Dir),1);       { Change root symbol back  }
  373.         Exit;                                { to null, 'cause \ added  }
  374.       end                                  { in later                 }
  375.       else
  376.       begin
  377.         BEEPIT;
  378.         WriteLn ('No such directory -- please try again.');
  379.         HALT;
  380.       end;
  381.     end;
  382.   end;
  383. end;
  384.  
  385. {
  386.    ┌────────────────────────────────────────────────────┐
  387.    │ MAin Program                                       │
  388.    └────────────────────────────────────────────────────┘
  389. }
  390.  
  391. begin
  392.  
  393.   Version   := 'Version 1.6, 7-16-90 -- Public Domain by John Land';
  394.                                                  { Sticks in EXE File      }
  395.  
  396.   Dir       := '';                               { Init. global Vars.      }
  397.   Loop      := True;
  398.   Level     := 0;
  399.   TreeOnly  := False;
  400.   tooDeep   := False;
  401.   Filetotal := 0;
  402.   Bytetotal := 0;
  403.   Dirstotal := 1;                                { Always have a root dir. }
  404.   ColorCnt  := 1;
  405.  
  406.   ClrScr;
  407.  
  408.   if ParamCount > 0 then
  409.     Read_Parm;              { Deal With any params.   }
  410.  
  411.   if not TreeOnly then
  412.     DisplayHeader;
  413.  
  414.   ReadFiles (Dir,'',0,0);                        { do main read routine    }
  415.  
  416.   TextColor(Yellow);
  417.  
  418.   if not TreeOnly then
  419.     DisplayTally;             { Display totals          }
  420.  
  421.   if tooDeep then
  422.     WriteLn (NL,NL,'':22,'» CANnot DISPLAY MorE THAN 5 LEVELS «',NL);
  423.                                                  { if ReadFiles detects >5 }
  424.                                                  { levels, tooDeep flag set}
  425.  
  426. end.
  427.